!> author: 左志华
!> date: 2022-07-16
!>
module test_sph_external_force

    use testdrive, only: new_unittest, unittest_type, error_type, check
    use sph_kinds, only: rk
    use sph_region, only: region_t
    use sph_external_force, only: external_force_with_gravity, external_force_without_gravity, &
                                r0, dd
    use twin_sph_list_type, only: twin_list_t
    use sph_env, only: nums
    implicit none
    private

    public :: collect_external_force

contains

    subroutine collect_external_force(testsuite)
        type(unittest_type), intent(out), allocatable :: testsuite(:)

        allocate (testsuite, source=[ &
                  new_unittest("FUNC: external_force_with_gravity", test_external_force_with_gravity), &
                  new_unittest("FUNC: external_force_without_gravity", test_external_force_without_gravity) &
                  ])

    end subroutine collect_external_force

    subroutine test_external_force_with_gravity(error)
        type(error_type), intent(out), allocatable :: error
        type(region_t) :: region
        type(twin_list_t) :: pairs

        ! 部署 region 和 pairs，一个实粒子、一个虚粒子
        nums(1) = 2
        region%particles%loc = reshape([0.0_rk, 0.0_rk, 1.0_rk, 0.0_rk], [2, 2])
        region%particles%itype = [-2, 2]
        allocate (region%particles%acc(2, 2), source=0.0_rk)

        pairs%log = 1
        pairs%items = reshape([1, 2], [2, 1])

        ! 配置函数参数
        r0 = 1.1_rk
        dd = 0.1_rk

        call external_force_with_gravity(region%particles, pairs, region%particles%acc)
        call check(error, region%particles%acc(1, 2), 0.16743283767210024_rk, "external_force_with_gravity::x")
        if (allocated(error)) return

        call check(error, region%particles%acc(2, 2), -9.806_rk, "external_force_with_gravity::y")

    end subroutine test_external_force_with_gravity

    subroutine test_external_force_without_gravity(error)
        type(error_type), intent(out), allocatable :: error
        type(region_t) :: region
        type(twin_list_t) :: pairs

        ! 部署 region 和 pairs，一个实粒子、一个虚粒子
        nums(1) = 2
        region%particles%loc = reshape([0.0_rk, 0.0_rk, 1.0_rk, 0.0_rk], [2, 2])
        region%particles%itype = [-2, 2]
        allocate (region%particles%acc(2, 2), source=0.0_rk)

        pairs%log = 1
        pairs%items = reshape([1, 2], [2, 1])

        ! 配置函数参数
        r0 = 1.1_rk
        dd = 0.1_rk

        call external_force_without_gravity(region%particles, pairs, region%particles%acc)
        call check(error, region%particles%acc(1, 2), 0.16743283767210024_rk, "external_force_without_gravity::x")
        if (allocated(error)) return

        call check(error, region%particles%acc(2, 2), 0.0_rk, "external_force_without_gravity::y")

    end subroutine test_external_force_without_gravity

end module test_sph_external_force
